{
  Yggdrasil process unit
  Maintainer(s): Timothy O'Neill
}

unit UProcess;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ShellAPI, TlHelp32,
  UConsole, UFunctions, UHook;

type
  PHMODULE = ^HMODULE;

function EnumProcessModules(hProcess : THandle;
                            lphModule : PHMODULE;
                            dwCb : DWord;
                            var dwCbNeeded : DWord) : Bool; stdcall;
                            external 'psapi.dll' name 'EnumProcessModules';
function GetModuleFileNameExW(hProcess : THandle;
                              hMod : HMODULE;
                              lpFilename : PWideChar;
                              nSize : DWord) : DWord; stdcall;
                              external 'psapi.dll' name 'GetModuleFileNameExW';

//Public types
type
  GameProcess = record
    Handle  : HWND;
    PID     : Cardinal;
    Thread  : Cardinal;
  end;
  AString = Array of String;

//Public variables
var
  TargetGame : GameProcess;

const
  TargetExe = 'ideal.exe';

//Public functions
function GetProcessModules(dwProcessID : DWord) : AString;
function GetModuleBaseAddress(iProcID : Cardinal; DLLName : String) : Cardinal;
procedure ShellGame;
function ConvertPID(tPID : Dword) : HWND;

implementation

function GetProcessModules(dwProcessID : DWord) : AString;
var
  rModules : AString;
  hProcess : THandle;
  hMods : Array of HMODULE;
  dwNeeded : DWord;
  dwModNum : DWord;
  i : Integer;
  szModName : Array[0..MAX_PATH] of WideChar;
begin
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
                          False,
                          dwProcessID);
  if hProcess <> 0 then begin
    try
      if Win32Check(EnumProcessModules(hProcess, Nil, 0, dwNeeded)) then begin
        dwModNum := dwNeeded div Sizeof(HMODULE);
        SetLength(hMods, dwModNum);
        SetLength(rModules, dwModNum);
        if Win32Check(EnumProcessModules(hProcess,
                                         @hMods[0],
                                         dwModNum * Sizeof(HMODULE),
                                         dwNeeded)) then begin
          for i := 0 to dwModNum - 1 do begin
            if GetModuleFileNameExW(hProcess,
                                    hMods[i],
                                    szModName,
                                    sizeof(szModName)) > 0 then begin

              rModules[i] := szModName;
            end;
          end;
        end;
      end;
    finally
      CloseHandle(hProcess);
    end;
  end;

  Result := rModules;
end;

function GetModuleBaseAddress(iProcID : Cardinal; DLLName : String) : Cardinal;
var
  hSnap : THandle;
  eModule : ModuleEntry32;
  mBaseAddress : Cardinal;
begin
  mBaseAddress := 0;
  hSnap := CreateToolHelp32Snapshot(TH32CS_SNAPMODULE, iProcID);
  eModule.dwSize := sizeof(eModule);
  if Module32First(hSnap, eModule) then begin
    while Module32Next(hSnap, eModule) do begin
      if eModule.szModule = DLLName then begin
        mBaseAddress := Cardinal(eModule.modBaseAddr);
      end;
    end;
  end;
  CloseHandle(hSnap);

  Result := mBaseAddress;
end;

procedure ProcessHeartbeat();
var
  Frequency, StartTime, StopTime : int64;
  TimeSeconds : real;
begin
  repeat
    //Set timer
    QueryPerformanceFrequency(Frequency);
    QueryPerformanceCounter(StartTime);
    repeat
      QueryPerformanceCounter(StopTime);
      TimeSeconds := ((StopTime - StartTime) / Frequency);
      Application.ProcessMessages;
    until TimeSeconds > 5;
    ShowStatus('Heartbeat...');
    Application.ProcessMessages;
  until ConvertPID(TargetGame.PID) = 0;
  ShowWarning(TargetExe + ' has closed');
  //Close;
end;

procedure ModuleList(AModules : AString);
var
  i : Integer;
  ModuleFile : String;
  BaseAddress : Cardinal;
begin
  for i := 0 to High(AModules) do begin
    ModuleFile := copy(AModules[i],
                       (posrev('\', AModules[i]) + 1),
                       (length(AModules[i]) - (posrev('\', AModules[i]) + 1) + 1));
    BaseAddress := GetModuleBaseAddress(TargetGame.PID, ModuleFile);
    ShowStatus('  ' + ModuleFile + ' (0x' + IntToHex(BaseAddress, 8) + ')');
  end;
end;

procedure ShellGame;
var
  Process   : Dword;
  StartInfo : TStartupInfo;
  ProcInfo  : TProcessInformation;
  Created   : Boolean;
  Path      : array [0..MAX_PATH] of Char;
begin
  ShowStatus('Creating ' + TargetExe + '...');

  FillChar(StartInfo, SizeOf(TStartupInfo), #0);
  FillChar(ProcInfo, SizeOf(TProcessInformation), #0);
  StartInfo.cb := SizeOf(TStartupInfo);

  Created := CreateProcess(nil, 'ideal.exe', nil, nil, False, 0, nil, nil,
                           StartInfo, ProcInfo);
  //Inject
  Process := ProcInfo.hProcess;
  GetCurrentDirectory(MAX_PATH, Path);
  InjectLibrary(Process, Path + '\yggy.dll');
  ShowStatus('Injected ' + Path + '\yggy.dll!');

  if Created then begin
    with TargetGame do begin
      PID    := ProcInfo.dwProcessId;
      Thread := ProcInfo.dwThreadId;
      ShowStatus('Process created!');
      //ShowStatus('Thread ID: ' + inttostr(Thread));
      //ShowStatus('Process ID: ' + inttostr(PID));
      Sleep(1000);
      //ShowStatus('Module list:');
      //ModuleList(GetProcessModules(PID));
      //Monitor
      ProcessHeartbeat();
    end;
  end
  else
    ShowError('Could not create process!');
end;

function ConvertPID(tPID : DWord) : HWND;
var
  tempHWND : HWND;
  tempPID  : DWord;
begin
  //Grab the first window handle that Windows finds
  tempHWND := FindWindow(nil, nil);
  repeat
    if GetParent(tempHWND) = 0 then begin
      GetWindowThreadProcessId(tempHWND, @tempPID);
      if tPID = tempPID then break
    end;

    tempHWND := GetWindow(tempHWND, GW_HWNDNEXT);
  until tempHWND = 0;

  Result := tempHWND;
end;

end.
